home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue66 / Construc / Refactor / Source / fBuildMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-15  |  20.8 KB  |  653 lines
  1. unit fBuildMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, ComCtrls, ToolWin, ActnList, Menus, Buttons, uBuildingObject;
  8.  
  9. type
  10.   TF_BuildMain = class(TForm)
  11.     StatusBar1: TStatusBar;
  12.     MainMenu1: TMainMenu;
  13.     File1: TMenuItem;
  14.     NewProject1: TMenuItem;
  15.     OpenProject1: TMenuItem;
  16.     SaveProject1: TMenuItem;
  17.     N1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     Options1: TMenuItem;
  20.     Compiler1: TMenuItem;
  21.     Path1: TMenuItem;
  22.     ClientDestination1: TMenuItem;
  23.     ServerDestination1: TMenuItem;
  24.     ActionList1: TActionList;
  25.     A_newProject: TAction;
  26.     A_saveProject: TAction;
  27.     A_exit: TAction;
  28.     A_ViewCompilerOptionsHelp: TAction;
  29.     A_DebugCompilerOptions: TAction;
  30.     A_defaultDestination: TAction;
  31.     A_serverDestination: TAction;
  32.     A_Build: TAction;
  33.     A_addFile: TAction;
  34.     Panel3: TPanel;
  35.     Panel4: TPanel;
  36.     Panel2: TPanel;
  37.     Label2: TLabel;
  38.     ToolBar2: TToolBar;
  39.     M_LibraryPath: TMemo;
  40.     Panel1: TPanel;
  41.     Label1: TLabel;
  42.     M_CFGFile: TMemo;
  43.     Splitter1: TSplitter;
  44.     Splitter2: TSplitter;
  45.     Panel5: TPanel;
  46.     Panel6: TPanel;
  47.     Panel7: TPanel;
  48.     L_progress: TLabel;
  49.     Panel8: TPanel;
  50.     Label3: TLabel;
  51.     Label4: TLabel;
  52.     Label5: TLabel;
  53.     Splitter3: TSplitter;
  54.     ToolBar3: TToolBar;
  55.     ToolButton7: TToolButton;
  56.     ToolButton8: TToolButton;
  57.     ToolButton9: TToolButton;
  58.     ToolButton10: TToolButton;
  59.     M_Destination: TMemo;
  60.     M_source: TMemo;
  61.     Splitter4: TSplitter;
  62.     OpenDialog: TOpenDialog;
  63.     bb_Build: TBitBtn;
  64.     b_exit: TBitBtn;
  65.     tb_extract: TToolButton;
  66.     A_extractPath: TAction;
  67.     Panel9: TPanel;
  68.     cb_ProjectList: TComboBox;
  69.     Label6: TLabel;
  70.     bb_newProject: TBitBtn;
  71.     bb_save: TBitBtn;
  72.     LB_exe: TListBox;
  73.     A_DeleteFile: TAction;
  74.     A_FileUp: TAction;
  75.     A_fileDown: TAction;
  76.     Action1: TAction;
  77.     bb_halt: TBitBtn;
  78.     A_openProject: TAction;
  79.     b_setVerInfo: TButton;
  80.     tb_editFilesINI: TToolButton;
  81.     BitBtn2: TBitBtn;
  82.     ToolBar1: TToolBar;
  83.     lb_result: TListBox;
  84.     tb_nexterror: TToolButton;
  85.     tb_loadDPR: TToolButton;
  86.     tb_loadPasfile: TToolButton;
  87.     About1: TMenuItem;
  88.     Button1: TButton;
  89.     procedure A_saveProjectExecute(Sender: TObject);
  90.     procedure A_extractPathExecute(Sender: TObject);
  91.     procedure FormCreate(Sender: TObject);
  92.     procedure cb_ProjectListChange(Sender: TObject);
  93.     procedure LB_exeClick(Sender: TObject);
  94.     procedure A_BuildExecute(Sender: TObject);
  95.     procedure A_newProjectExecute(Sender: TObject);
  96.     procedure A_addFileExecute(Sender: TObject);
  97.     procedure A_fileDownExecute(Sender: TObject);
  98.     procedure A_FileUpExecute(Sender: TObject);
  99.     procedure A_DeleteFileExecute(Sender: TObject);
  100.     procedure M_CFGFileChange(Sender: TObject);
  101.     procedure A_exitExecute(Sender: TObject);
  102.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  103.     procedure bb_haltClick(Sender: TObject);
  104.     procedure A_ViewCompilerOptionsHelpExecute(Sender: TObject);
  105.     procedure A_defaultDestinationExecute(Sender: TObject);
  106.     procedure tb_editFilesINIClick(Sender: TObject);
  107.     procedure lb_resultDblClick(Sender: TObject);
  108.     procedure tb_nexterrorClick(Sender: TObject);
  109.     procedure tb_loadDPRClick(Sender: TObject);
  110.     procedure tb_loadPasfileClick(Sender: TObject);
  111.     procedure About1Click(Sender: TObject);
  112.     procedure b_setVerInfoClick(Sender: TObject);
  113.     procedure Button1Click(Sender: TObject);
  114.   private
  115.     fProjectList : tstringlist;
  116.     fProjectDir : string;
  117.     fProjectName : string;
  118.     fExeList : tstringlist;
  119.     fProjectChanged : boolean;
  120.     fHaltNow : boolean;
  121.     fDefaultTargetDir : string;
  122.     fMostRecentError : integer;
  123.     fCurrentPas,
  124.     fCurrentDPR : string;
  125.     fBuildObj : TBuilderClass;
  126.     procedure SaveProjectDialog;
  127.       // save the three project files from the current set up
  128.     procedure ReadProjectData;
  129.       // read the three project files, files.ini, library.path, and base.cfg
  130.     procedure HandleCompileEnd(const aSourceFile, aDestFile,
  131.       aErrMsg: string; aSuccess: boolean; alines, ahints, awarnings,
  132.       aerrors, afatal: integer);
  133.     procedure HandleCompileNotify(const aSourcefile, Info: string);
  134.     procedure HandleCompileStart(const aSourceFile, aDestFile,
  135.       aErrMsg: string);
  136.     procedure HandleProjectDone(const aProjectName: string; aOK, aErr,
  137.       alines, ahints, awarnings, aerrors, afatal: integer);
  138.     procedure HandleProjectHalt(const aSourcefile, Info : string);
  139.   public
  140.     { Public declarations }
  141.   end;
  142.  
  143. var
  144.   F_BuildMain: TF_BuildMain;
  145.  
  146. implementation
  147. uses inifiles, FileCtrl,
  148.      uSelectDir, DOSToMemo, IDELibPath, fMainForm;
  149. //     Fresourceeditor;
  150.  
  151. const
  152.   cProject = 'Projects';
  153.   cDPR = 'DPR';
  154.  
  155. {$R *.DFM}
  156.  
  157.  
  158.  
  159.  
  160. procedure TF_BuildMain.A_saveProjectExecute(Sender: TObject);
  161. var i : integer;
  162. begin
  163.   chdir(fProjectDir);
  164.   with tinifile.create(SlashSep(fprojectdir,'files.ini')) do begin
  165.     for i := 0 to fExeList.count-1 do begin
  166.        writeString(cDPR, fexeList.names[i], fexeList.values[fexeList.names[i]]);
  167.         end;
  168.     free;
  169.     end;
  170.   m_cfgfile.lines.SaveToFile('base.cfg');
  171.   m_LibraryPath.lines.SaveToFile('Library.path');
  172.   fProjectChanged := false;
  173. end;
  174.  
  175.  
  176. procedure TF_BuildMain.A_extractPathExecute(Sender: TObject);
  177. begin
  178.   M_LibraryPath.lines.assign(GetIdeLibraryPath);
  179.   fProjectChanged := true;
  180. end;
  181.  
  182. procedure TF_BuildMain.FormCreate(Sender: TObject);
  183. var I : integer;
  184. begin
  185.   fMostRecentError := 0;
  186.   fProjectChanged := false;
  187.   fProjectList := tstringlist.create;
  188.   fExeList := tstringlist.create;
  189.   with tinifile.create(ChangeFileExt(application.exename, '.ini')) do begin
  190.     readSectionvalues(cProject, fProjectList);
  191.     free;
  192.     end;
  193.   for i := 0 to fProjectList.count-1 do
  194.     cb_projectList.items.add(fProjectList.names[i]);
  195.   cb_projectList.text := '';
  196.   if fProjectlist.count > 0
  197.     then begin
  198.       cb_ProjectList.itemindex := 0;
  199.       fProjectName := fProjectList.names[cb_projectList.itemindex];
  200.       fProjectDir := fProjectList.values[fProjectName];
  201.       chdir(fProjectdir);
  202.       end
  203.     else cb_ProjectList.itemindex := -1;
  204.  
  205.   ReadProjectData;
  206.   // Make sure we have a place to send dcu files to
  207.   ForceDirectories('C:\Program Files\Borland\Delphi4\DCU');
  208.   fBuildObj := TBuilderClass.create(self);
  209. end;
  210.  
  211. Procedure TF_BuildMain.ReadProjectData;
  212. var i : integer;
  213. begin
  214.   m_cfgFile.clear;
  215.   if fileExists('Base.cfg')
  216.     then m_cfgFile.lines.loadfromfile('Base.cfg');
  217.   m_libraryPath.clear;
  218.   if fileExists('Library.path')
  219.     then m_LibraryPath.lines.loadfromFile('Library.path');
  220.   fExeList.clear;  
  221.   lb_exe.clear;
  222.   m_source.clear;
  223.   m_destination.clear;
  224.   if fprojectdir = '' then exit;
  225.   with tinifile.create(SlashSep(fprojectdir,'files.ini')) do begin
  226.      readSectionValues(cDPR, fExeList);
  227.      for i := 0 to fExeList.count-1 do begin
  228.         LB_exe.items.add(extractFileName(fExeList.names[i]));
  229.         end;
  230.      free;
  231.      end;
  232.   fProjectChanged := false;
  233.   lb_execlick(nil);
  234. end;
  235.  
  236. procedure TF_BuildMain.cb_ProjectListChange(Sender: TObject);
  237. begin
  238.   If cb_projectList.itemindex = -1
  239.     then exit
  240.     else begin
  241.       if fProjectChanged
  242.         then SaveProjectDialog;
  243.       fProjectName := fProjectList.names[cb_projectList.itemindex];
  244.       fProjectDir := fProjectList.values[fProjectName];
  245.       chdir(fProjectdir);
  246.       ReadProjectData;
  247.       bb_build.enabled := true;
  248.       bb_build.default := true;
  249.       end;
  250. end;
  251.  
  252. procedure TF_BuildMain.LB_exeClick(Sender: TObject);
  253. begin
  254.   if lb_exe.items.count = 0
  255.     then exit;
  256.   if (lb_exe.itemindex = -1)
  257.       and
  258.      (lb_exe.items.count > 0)
  259.     then lb_exe.itemindex := 0;
  260.   m_destination.text := fexeList.names[lb_exe.itemindex];
  261.   m_source.text := fexeList.values[fexeList.names[lb_exe.itemindex]];
  262. end;
  263.  
  264.  
  265.  
  266. Procedure TF_BuildMain.HandleCompileNotify(const aSourcefile, Info : string);
  267. begin
  268.   l_progress.caption := asourcefile + ': '+Info;
  269.   StatusBar1.simpleText := asourcefile + ': '+Info;
  270. end;
  271.  
  272. Procedure TF_BuildMain.HandleCompileStart(const aSourceFile, aDestFile, aErrMsg : string);
  273. begin
  274.   l_progress.caption := 'Compiling '+asourcefile + ' to '+aDestFile+': '+aErrMsg;
  275. end;
  276.  
  277. Procedure TF_BuildMain.HandleCompileEnd(const aSourceFile, aDestFile, aErrMsg : string; aSuccess : boolean; alines, ahints, awarnings, aerrors, afatal : integer);
  278. begin
  279.   l_progress.caption := 'Done with '+asourcefile + ' to '+aDestFile+': '+aErrMsg;
  280.   StatusBar1.simpleText := 'Error: '+aErrMsg+'  Lines: '+IntToStr(alines)+ ',  Hints: '+IntToStr(aHints)+ ',  Warnings: '+IntToStr(aWarnings)+',  Errors: '+IntToStr(aErrors)+',   Fatal: '+IntToStr(aFatal);
  281.   if not aSuccess
  282.     then if MessageDlg('Compile error.  Do you want to halt the build?', mtconfirmation, [mbyes, mbNo],0) = mrYes
  283.            then fBuildObj.HaltNow := true;
  284.   lb_result.items.assign(fBuildObj.ProjectSummary);
  285. end;
  286.  
  287. Procedure TF_BuildMain.HandleProjectDone(const aProjectName : string; aOK, aErr, alines, ahints, awarnings, aerrors, afatal : integer);
  288. begin
  289.   StatusBar1.simpleText := 'Final result is '+IntToStr(aOK)+' OK, '+IntToStr(aErr)+' ERR.   Lines: '+IntToStr(alines)+ ',  Hints: '+IntToStr(aHints)+ ',  Warnings: '+IntToStr(aWarnings)+',  Errors: '+IntToStr(aErrors)+',   Fatal: '+IntToStr(aFatal);
  290.   lb_result.items.assign(fBuildObj.ProjectSummary);
  291.   lb_result.items.addstrings(fBuildObj.ProjectResults);
  292. end;
  293.  
  294. Procedure TF_BuildMain.HandleProjectHalt(const aSourcefile, Info : string);
  295. begin
  296.   StatusBar1.simpleText := 'Project halted: '+aSourceFile +': '+Info;
  297.   l_progress.caption := 'Project halted: '+Info;
  298. end;
  299.  
  300.  
  301.  
  302. procedure TF_BuildMain.A_BuildExecute(Sender: TObject);
  303. begin
  304.   fHaltNow := false;
  305.   bb_halt.enabled := true;
  306.   bb_build.enabled := false;
  307.   lb_result.items.clear;
  308.   lb_result.color := clWhite;
  309.   A_viewCompilerOptionsHelp.Checked := false;
  310.   l_progress.caption := 'Starting project '+fprojectdir;
  311.   LB_exe.itemindex := 0;
  312.  
  313.   fBuildObj.ProjectName := 'testing';
  314.   fBuildObj.ProjectDir := fProjectdir;
  315.   fBuildObj.OnCompileEvent := HandleCompileNotify;
  316.   fBuildObj.OnCompileStart := HandleCompileStart;
  317.   fBuildObj.OnCompileEnd :=  HandleCompileEnd;
  318.   fBuildObj.OnProjectDone := HandleProjectDone;
  319.   fBuildObj.OnProjectHalt := HandleProjectHalt;
  320.   fBuildObj.execute;
  321.   b_exit.default := true;
  322. end;
  323.  
  324. {
  325. var errMsg, cmdline,
  326.     UnitSearchPath, tmp  : string;
  327.     success : boolean;
  328.     i, j, subLines, totlines, subHints, totHints, subWarn, totWarn,
  329.     subErr, totErr, subFat, totFat, OKs, errs : integer;
  330.     tmpsl, configFile, pathFile,
  331.     results, summary : tstringlist;
  332.     st, et: TDateTime;
  333.     h, m, s, ms: Word;
  334. begin
  335.   try
  336.     fHaltNow := false;
  337.     bb_halt.enabled := true;
  338.     tmpsl := tstringlist.create;
  339.     results := tstringlist.create;
  340.     summary := tstringlist.create;
  341.     summary.add('Build started '+FormatDateTime('ddd, dd mmm yyyy  hh:nn:ss', now)+#13#10);
  342.     lb_exe.itemindex := 0;
  343.     A_saveProjectExecute(Sender);
  344.     chdir(fProjectdir);
  345.     totlines := 0;
  346.     totHints := 0;
  347.     totWarn := 0;
  348.     totErr := 0;
  349.     totFat := 0;
  350.     OKs := 0;
  351.     Errs := 0;
  352.     lb_result.items.clear;
  353.     lb_result.color := clWhite;
  354.     A_viewCompilerOptionsHelp.Checked := false;
  355.     l_progress.caption := 'Starting project '+fprojectdir;
  356.     LB_exe.itemindex := 0;
  357.     for i := 0 to fexeList.count-1 do begin
  358.       if fHaltNow then break;
  359.       LB_exeClick(sender);
  360.       with fBuildObj do begin
  361.         InFile :=  extractFilePath(application.exename)+'builder.ini';
  362.         Outfile := SlashSep(fProjectDir,'dump.dat');
  363.         ProjectDir := fProjectDir;
  364.         SourceFullFileName := m_source.text;
  365.         if pos('.RC', m_source.text) = 0
  366.           then CompileType := ctDPR
  367.           else CompileType := ctRC;
  368.         DestinationFullFileName :=  m_destination.text;
  369.         OnCompile := HandleBuildNotify;
  370.         if Execute
  371.           then begin
  372.             if Success
  373.               then Inc(OKs)
  374.               else Inc(Errs);
  375.             TotLines := TotLines+Lines;
  376.             TotWarn := TotWarn+Warnings;
  377.             TotHints :=TotHints+Hints;
  378.             TotErr := TotErr+Errors;
  379.             TotFat := TotFat+Fatals;
  380.             end
  381.           else begin
  382.             Inc(Errs);
  383.             end;
  384.           TotLines := TotLines + lines;
  385.           tmp := IntToStr(OKs)+' OK, '+IntToStr(Errs)+' ERR.   Lines: '+IntToStr(Totlines)+ ',  Hints: '+IntToStr(TotHints)+ ',  Warnings: '+IntToStr(TotWarn)+',  Errors: '+IntToStr(TotErr)+',   Fatal: '+IntToStr(TotFat);
  386.           StatusBar1.simpleText := tmp;
  387.           lb_Result.items.assign(Results);
  388.         end;
  389.       Application.processMessages;
  390.       Summary.addstrings(lb_result.items);
  391.       lb_exe.itemindex := lb_exe.itemindex + 1;
  392.       if lb_exe.itemindex = lb_exe.items.count
  393.         then break;
  394.       end;
  395.     tmp := 'Final result is '+IntToStr(OKs)+' OK, '+IntToStr(Errs)+' ERR.   Lines: '+IntToStr(TotLines)+ ',  Hints: '+IntToStr(TotHints)+ ',  Warnings: '+IntToStr(TotWarn)+',  Errors: '+IntToStr(TotErr)+',   Fatal: '+IntToStr(TotFat);
  396.     fBuildObj.results.insert(0,tmp);
  397.     //fBuildObj.SaveResults;
  398.     lb_result.items.assign(results);
  399.   except
  400.     on e:exception do begin
  401.       results.Insert(0, 'Exception thrown: '+e.message+#13#10);
  402.       lb_result.items.assign(results);
  403.       lb_result.items.saveToFile(outfile);
  404.       end;
  405.   end;
  406.   bb_halt.enabled := false;
  407.   results.Free;
  408.   tmpsl.free;
  409.   configFile.free;
  410.   PathFile.free;
  411.   summary.free;
  412. end;
  413. }
  414.  
  415. procedure TF_BuildMain.A_newProjectExecute(Sender: TObject);
  416. var dir : string;
  417.     i : integer;
  418. begin
  419.   if MySelectDirectory('Select Project specs directory', dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0)
  420.     then begin
  421.       if fProjectChanged
  422.         then SaveProjectDialog;
  423.       fProjectDir := dir;
  424.       for i := length(dir) downto 1 do
  425.         if dir[i] = '\'
  426.           then begin
  427.             fProjectName := copy(dir, i+1, 200);
  428.             break;
  429.             end;
  430.       cb_projectList.items.add(fprojectNAme);
  431.       cb_projectList.text := fProjectNAme;
  432.       fProjectList.add(fProjectName+'='+fProjectDir);
  433.       chdir(fProjectDir);
  434.       ReadProjectData;
  435.       with tinifile.create(ChangeFileExt(application.exename, '.ini')) do begin
  436.         writeString(cProject, fProjectName, fProjectDir);
  437.         free;
  438.         end;
  439.       end;
  440. end;
  441.  
  442. procedure TF_BuildMain.A_addFileExecute(Sender: TObject);
  443. var i : integer;
  444.     dir, fname : string;
  445. begin
  446.   with opendialog do begin
  447.     filter := 'Project files (dpr, dpk, rc)|*.dpr;*.dpk;*.rc';
  448.     options := [ofHideReadOnly,ofAllowMultiSelect,ofPathMustExist,ofFileMustExist,ofEnableSizing];
  449.     Title := 'select file(s) (dpr, dpk or rc) to be in project';
  450.     if execute
  451.       then begin
  452.         for i := 0 to files.count-1 do begin
  453.           fname := extractfilename(files[i]);
  454.           dir := fDefaultTargetDir;
  455.           if not MySelectDirectory('Select Target Directory', dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0)
  456.             then dir := extractFilePath(files[i]);
  457.           if pos('.exe', fname) > 0
  458.             then fname := changeFileExt(fname, '.exe')
  459.           else if pos('.dpk', fname) > 0
  460.             then fname := changeFileExt(fname, '.bpl')
  461.           else if pos('.rc', fname) > 0
  462.             then fname := changeFileExt(fname, '.res');
  463.           lb_exe.items.add(fname);
  464.           fExeList.add(dir+'\'+fname+'='+files[i]);
  465.           fProjectChanged := true;
  466.           lb_exe.itemindex := lb_exe.items.count-1;
  467.           lb_exeClick(sender);
  468.           end;
  469.         end;
  470.     end;
  471. end;
  472.  
  473. procedure TF_BuildMain.SaveProjectDialog;
  474. begin
  475.   If MessageDlg('Project '+fProjectdir+' has changed.  Do you wish to save the changes?', mtConfirmation, [mbYEs, mbNo],0) = mrYes
  476.     then A_saveProjectExecute(nil);
  477. end;
  478.  
  479. procedure TF_BuildMain.A_fileDownExecute(Sender: TObject);
  480. var i : integer;
  481. begin
  482.   i := lb_exe.itemindex;
  483.   if (i = -1) or (i = lb_exe.items.count-1) then exit;
  484.   lb_exe.Items.Move(lb_exe.itemindex, lb_exe.itemindex+1);
  485.   fExeList.Move(i, i+1);
  486.   lb_exe.itemindex := i+1;
  487.   fProjectChanged := true;
  488.   LB_exeClick(sender);
  489. end;
  490.  
  491. procedure TF_BuildMain.A_FileUpExecute(Sender: TObject);
  492. var i : integer;
  493. begin
  494.   i := lb_exe.itemindex;
  495.   if (i = -1) or (i = 0) then exit;
  496.   lb_exe.Items.Move(lb_exe.itemindex, lb_exe.itemindex-1);
  497.   fExeList.Move(i, i-1);
  498.   lb_exe.itemindex := i-1;
  499.   fProjectChanged := true;
  500.   LB_exeClick(sender);
  501. end;
  502.  
  503. procedure TF_BuildMain.A_DeleteFileExecute(Sender: TObject);
  504. var i : integer;
  505. begin
  506.   i := lb_exe.itemindex;
  507.   if i = -1 then exit;
  508.   lb_exe.items.delete(i);
  509.   fexeList.delete(i);
  510.   fProjectChanged := true;
  511.   LB_exeClick(sender);
  512. end;
  513.  
  514. procedure TF_BuildMain.M_CFGFileChange(Sender: TObject);
  515. begin
  516.   fProjectChanged := true;
  517. end;
  518.  
  519. procedure TF_BuildMain.A_exitExecute(Sender: TObject);
  520. begin
  521.   if fProjectChanged
  522.     then SaveProjectDialog;
  523.   close;
  524. end;
  525.  
  526. procedure TF_BuildMain.FormClose(Sender: TObject;
  527.   var Action: TCloseAction);
  528. begin
  529.   if fProjectChanged
  530.     then SaveProjectDialog;
  531.   Action := caFree;
  532. end;
  533.  
  534. procedure TF_BuildMain.bb_haltClick(Sender: TObject);
  535. begin
  536.   fHaltNow := true;
  537. end;
  538.  
  539. procedure TF_BuildMain.A_ViewCompilerOptionsHelpExecute(Sender: TObject);
  540. begin
  541.   lb_result.clear;
  542.   if A_viewCompilerOptionsHelp.Checked
  543.     then begin
  544.       lb_result.clear;
  545.       lb_result.color := clWhite;
  546.       l_progress.caption := '';
  547.       A_viewCompilerOptionsHelp.Checked := false;
  548.       end
  549.     else begin
  550.       l_progress.caption := 'DCC32 options';
  551.       lb_result.color := clGray;
  552.       lb_result.items.loadfromFile(extractFilePath(application.exename)+'\options.txt');
  553.       A_viewCompilerOptionsHelp.Checked := true;
  554.       end;
  555. end;
  556.  
  557. procedure TF_BuildMain.A_defaultDestinationExecute(Sender: TObject);
  558. var dir : string;
  559. begin
  560.   if MySelectDirectory('Select Default Target Directory', dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0)
  561.     then fDefaultTargetDir := dir;
  562. end;
  563.  
  564. procedure TF_BuildMain.tb_editFilesINIClick(Sender: TObject);
  565. begin
  566.   lb_result.items.LoadFromFile(fProjectDir+'Files.ini');
  567. end;
  568.  
  569.  
  570. procedure TF_BuildMain.lb_resultDblClick(Sender: TObject);
  571. begin
  572.   l_progress.caption := lb_result.items[lb_result.itemindex];
  573. end;
  574.  
  575. procedure TF_BuildMain.tb_nexterrorClick(Sender: TObject);
  576. var i,j : integer;
  577.     tmp : string;
  578. begin
  579.   for i := fMostRecentError+1 to lb_result.items.count-1 do begin
  580.     if pos(' Error: ', lb_result.items[i]) <> 0
  581.       then begin
  582.         fMostRecentError := i;
  583.         fCurrentPas := copy(lb_result.items[i], 1, pos('(', lb_result.items[i])-1);
  584.         if pos('\', fCurrentPas) = 0
  585.           then fCurrentPas := extractFilePath(fCurrentDPR)+fcurrentpas;
  586.         break;
  587.         end;
  588.     tmp := 'DCC started: DCC32.exe ';
  589.     if pos(tmp, lb_result.items[i]) <> 0
  590.       then begin
  591.          tmp := copy(lb_result.items[i], length(tmp), 100);
  592.          tmp := trim(copy(tmp, 1, pos('.', tmp)));
  593.          for j := 0 to lb_exe.items.count-1 do
  594.            if pos(uppercase(tmp), uppercase(lb_exe.items[j])) = 1
  595.              then begin
  596.                 lb_exe.itemindex := j;
  597.                 fCurrentDPR := fexeList.values[fexeList.names[j]];
  598.                 end;
  599.          end;
  600.     if i = lb_result.items.count-1
  601.       then l_progress.caption := 'No more errors';
  602.     end;
  603.  lb_result.itemindex := fMostRecentError;
  604. end;
  605.  
  606. procedure TF_BuildMain.tb_loadDPRClick(Sender: TObject);
  607. var cmdline : string;
  608.     success : boolean;
  609.      SI: TStartupInfo;
  610.      PI: TProcessInformation;
  611. begin
  612.   FillChar(SI, SizeOf(SI), 0);
  613.   cmdline := 'Delphi32.exe /hm /hv '+fCurrentDPR;    // /np means no project, just the file
  614.   success := CreateProcess(nil,pchar(cmdline),nil,nil,True,NORMAL_PRIORITY_CLASS,
  615.                             nil,nil,SI, PI);
  616.   if not success
  617.     then showmessage('error launching Delphi');
  618.  
  619. end;
  620.  
  621. procedure TF_BuildMain.tb_loadPasfileClick(Sender: TObject);
  622. var cmdline : string;
  623.     success : boolean;
  624.      SI: TStartupInfo;
  625.      PI: TProcessInformation;
  626. begin
  627.   FillChar(SI, SizeOf(SI), 0);
  628.   cmdline := 'Delphi32 /hm /hv '+fCurrentPas;    // /np means no project, but won'just the file
  629.   success := CreateProcess(nil,pchar(cmdline),nil,nil,True,NORMAL_PRIORITY_CLASS,
  630.                             nil,nil,SI, PI);
  631.   if not success
  632.     then showmessage('error launching Delphi');
  633. end;
  634.  
  635. procedure TF_BuildMain.About1Click(Sender: TObject);
  636. begin
  637.  // MOHAboutDialog1.execute;
  638. end;
  639.  
  640. procedure TF_BuildMain.b_setVerInfoClick(Sender: TObject);
  641. begin
  642.   Showmessage('set changes to version info in the myproject.ver file file; '#13#10'there needs to be an myproject.ico file present also');
  643. end;
  644.  
  645. procedure TF_BuildMain.Button1Click(Sender: TObject);
  646. begin
  647.     F_MainForm := TF_MainForm.create(application);
  648.     f_mainForm.showmodal;
  649.  
  650. end;
  651.  
  652. end.
  653.